home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / comm / misc / mirrorman_1_10b1.lha / MirrorManager-1.10b1 / rexx / MakeIndex.mm < prev    next >
Text File  |  1994-06-24  |  16KB  |  573 lines
  1. /*rx
  2.     $VER: $Id: MakeIndex.mm,v 1.9 1994/06/20 01:08:21 tf Exp $
  3.  
  4.     This script is ment to create a local Aminet mirror index.
  5.     In general it creates a list of all files available in a given
  6.     path including file size and file comment.
  7.  
  8.     Due to a problem with pragma('D') you *MUST* execute this script
  9.     using RX explicitly -- even in the WShell.
  10.  
  11.     This ARexx script needs the AmigaDOS commands "List" and "Sort"
  12.     available in your path.
  13.  
  14.     Initial revision by Tobias Ferber, 21-Feb-94
  15. */
  16.  
  17. options results
  18. options failat 21
  19.  
  20.  
  21. /* initialize globals */
  22.  
  23. headerline = "Index file as of" date('n')',' time('n')
  24. indexfile  = ""   /* the one which we are about to create */
  25. withfile   = ""   /* list of dirs and files to include or exclude */
  26. pathname   = ""   /* the top directory of the tree to be scanned in order to create the index file */
  27. tempfile   = "T:MakeIndexTemp." || pragma('Id')
  28. temphide   = "T:MakeIndexTempHide." || pragma('Id')
  29. lformat    = '%p' || '09'x || '%n' || '09'x || '%l' || '09'x || '%c'
  30. template   = "FROM/K/A,TO/K/A,WITH/K,HIDE/S,AUTO/S"
  31. hidestr    = ""
  32. args       = ""
  33. cliopts    = ""
  34.  
  35. dg       = 0  /* gauge increment */
  36. gstepN   = 0
  37.  
  38. ESC      = '1b'x
  39.  
  40. signal on HALT
  41. signal on BREAK_C
  42. signal on BREAK_D
  43.  
  44.  
  45. /* parse args */
  46.  
  47. do ac=1 while ac <= arg()
  48.   av= arg(ac)
  49.   select
  50.     when upper(av) = "FROM" then do
  51.       if ac < arg() then do
  52.         ac= ac+1
  53.         pathname= arg(ac)
  54.         if words(pathname) < 1 then pathname= pragma('D')
  55.         end
  56.       else exit bad_args('Missing pathname after' ESC'bFROM'ESC'n keyword.')
  57.       end /* FROM */
  58.  
  59.     when upper(av) = "TO" then do
  60.       if ac < arg() then do
  61.         ac= ac+1
  62.         indexfile= arg(ac)
  63.         end
  64.       else exit bad_args('Missing index filename after' ESC'bTO'ESC'n keyword.')
  65.       end /* TO */
  66.  
  67.     when upper(av) = "WITH" then do
  68.       if ac < arg() then do
  69.         ac= ac+1
  70.         withfile= arg(ac)
  71.         end
  72.       else exit bad_args('Missing filename after' ESC'bWITH'ESC'n keyword.')
  73.       end /* WITH */
  74.  
  75.     when upper(av) = "HIDE" then cliopts= cliopts || 'h'
  76.     when upper(av) = "AUTO" then cliopts= cliopts || 'a'
  77.  
  78.     otherwise exit bad_args('Unknown keyword:' ESC'b' || av || ESC'n')
  79.  
  80.     end /* select */
  81.  
  82.   end /* do */
  83.  
  84. call pragma('W','N')
  85.  
  86.  
  87. /* eventually try to get missing with file */
  88.  
  89. if pos('h',cliopts) > 0 then do
  90.   if words(withfile) < 1 then do
  91.     cwd= strip(pragma('D'),'B','"')
  92.     REQUESTFILE DRAWER '"'cwd'"' TITLE '"Hide files listed in..."' NOICONS
  93.     if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then withfile= result
  94.     end
  95.  
  96.   if words(withfile) < 1 then
  97.     exit bad_args("Not enough arguments for MakeIndex...*nExiting...")
  98.  
  99.   end
  100.  
  101. if (words(withfile) > 0) & ~exists(withfile) then do
  102.   REQUESTCHOICE TITLE   '"MakeIndex Request"',
  103.                 BODY    '"MakeIndex failed to locate your WITH file*n*n' ||,
  104.                         ESC'c'ESC'b' || withfile || ESC'n'ESC'l'         || '"',
  105.                 GADGETS '"Exit"'
  106.   exit 10
  107.   end
  108.  
  109.  
  110. /* try to get missing index file */
  111.  
  112. if words(indexfile) < 1 then do
  113.   cwd= strip(pragma('D'),'B','"')
  114.   REQUESTFILE DRAWER '"'cwd'"' TITLE '"Write index to file..."' NOICONS SAVEMODE
  115.   if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then indexfile= result
  116.   end
  117.  
  118. if words(indexfile) < 1 then
  119.   exit bad_args("Not enough arguments for MakeIndex...*nExiting...")
  120.  
  121.  
  122. if exists(indexfile) then do
  123.   REQUESTCHOICE TITLE   '"MakeIndex Request"',
  124.                 BODY    '"Index file*n*n'                              ||,
  125.                         ESC'c'ESC'b' || indexfile || ESC'n'ESC'l*n*n'  ||,
  126.                         'already exists.  Shall I replace it?'         || '"',
  127.                 GADGETS '"**_Yes|_No"'
  128.  
  129.   if result = 0 then do
  130.     REQUESTCHOICE TITLE '"MakeIndex Request"' BODY '"MakeIndex canceled"' GADGETS '"Exit"'
  131.     exit
  132.     end
  133.   end
  134.  
  135.  
  136. /* try to get missing from path */
  137.  
  138. if ( words(pathname) < 1 ) then do
  139.   cwd= strip(pragma('D'),'B','"')
  140.   REQUESTFILE DRAWER '"'cwd'"' TITLE '"Select a directory..."' DRAWERSONLY NOICONS
  141.   if (rc=0) & (words(result) > 0) & (result ~= 'RESULT') then pathname= result
  142.   end
  143.  
  144. if words(pathname) < 1 then
  145.   exit bad_args("Not enough arguments for MakeIndex...  Exiting...")
  146.  
  147. if pathname = '.' then pathname= pragma('D') /* current directory */
  148.  
  149. if ~exists(pathname) then do
  150.   REQUESTCHOICE TITLE   '"MakeIndex Request"',
  151.                 BODY    '"MakeIndex failed to locate your directory*n*n' ||,
  152.                         ESC'c'ESC'b' || pathname || ESC'n'ESC'l'         || '"',
  153.                 GADGETS '"Exit"'
  154.   exit 10
  155.   end
  156.  
  157.  
  158. signal on ERROR
  159. signal on IOERR
  160.  
  161. signal on FAILURE
  162. /*signal on NOVALUE*/
  163. signal on SYNTAX
  164.  
  165.  
  166. /* do the hard part */
  167.  
  168.  
  169. MESSAGE CLEAR; MESSAGE OPEN; COMPLETE 0
  170. WORKING '"Pass 1"'
  171.  
  172. if pos('h',cliopts) > 0 then do
  173.   err= listfiles(withfile,temphide)
  174.   if err > 0 then exit 10
  175.  
  176.   COMPLETE 25
  177.  
  178.   if filesize(temphide) ~= 0 then do
  179.     MESSAGE transquote('Sorting list of files to hide ...')
  180.     address command 'Sort FROM "' || temphide || '" TO "' || temphide || '"'
  181.  
  182.     COMPLETE 30
  183.  
  184.     if ~open('hp',temphide,'R') then do
  185.       MESSAGE transquote('Warning: Failed to open "'temphide'"... no files will be hidden')
  186.       cliopts= compress(cliopts,'h')
  187.       end
  188.     else do
  189.       do until eof('hp') | ( (words(hidestr) > 0) & (left(hidestr,1) ~= ':') )
  190.         hidestr= strip( readln('hp') )
  191.         end
  192.       if eof('hp') then do
  193.         call close('hp')
  194.         cliopts= compress(cliopts,'h')
  195.         withfile= ""
  196.         end
  197.       end
  198.     end
  199.  
  200.   else do
  201.     MESSAGE transquote('No files to hide ...')
  202.     COMPLETE 30
  203.     cliopts= compress(cliopts,'h')
  204.     end
  205.  
  206.   end /* hide */
  207.  
  208. COMPLETE 50
  209. MESSAGE transquote('Generating temporary index' tempfile 'from' pathname '...')
  210.  
  211. if (pos('h',cliopts) < 1) & (words(withfile) > 0) then do
  212.   err= listfiles(withfile,tempfile)
  213.   if err > 0 then exit 10
  214.   end
  215.  
  216. else do
  217.   cwd= pragma('D',pathname)
  218.   address command 'List ALL FILES LFORMAT "' || lformat || '" NOHEAD TO "' || tempfile || '"'
  219.   call pragma('D',cwd)
  220.   end
  221.  
  222. COMPLETE 75
  223.  
  224. if filesize(tempfile) ~= 0 then do
  225.   MESSAGE '"Sorting temporary index file ..."'
  226.   address command 'Sort FROM "' || tempfile || '" TO "' || tempfile || '"'
  227.  
  228.   COMPLETE 100
  229.   CALL init_gauge(tempfile,1)
  230.   WORKING '"Pass 2"'
  231.  
  232.   MESSAGE '"Generating' indexfile 'from' tempfile '..."'
  233.   if open('in',tempfile,'R') then do
  234.     if open('out',indexfile,'W') then do
  235.  
  236.       call writeln('out','|'headerline'0a'x'|')
  237.       call writeln('out','|File                Dir        Size Description')
  238.       call writeln('out','|'copies('-',80))
  239.  
  240.       do while ~eof('in')
  241.         CALL step_gauge(1)
  242.         str= strip( readln('in') )
  243.         if words(str) > 0 then do
  244.  
  245.           if (pos('h',cliopts) > 0) & (upper(str) = upper(hidestr)) then do
  246.             last_hidestr= hidestr; hidestr= ""
  247.             do until eof('hp') | ( (words(hidestr) > 0) & (left(hidestr,1) ~= ':') & (upper(hidestr) ~= upper(last_hidestr)) )
  248.               hidestr= strip( readln('hp') )
  249.               end
  250.  
  251.             if eof('hp') then do
  252.               call close('hp')
  253.               cliopts= compress(cliopts,'h')
  254.               end
  255.             end
  256.  
  257.           else do
  258.             parse var str pname '09'x fname '09'x fsize '09'x fnote
  259.  
  260.             pname= strip(pname,B,' ' || '09'x)
  261.             fname= strip(fname,B,' ' || '09'x)
  262.             fsize= strip(fsize,B,' ' || '09'x)
  263.             fnote= strip(fnote,B,' ' || '09'x)
  264.  
  265.             if right(pname,1) = '/' then pname = left(pname,length(pname)-1)
  266.             if pname = "" then pname = '.'
  267.  
  268.             call writeln('out', left(fname,20,' ') || ' ' ||,
  269.                                 left(pname,10,' ') || ' ' ||,
  270.                                 bkmg(fsize)        || ' ' ||,
  271.                                 fnote)
  272.             end
  273.  
  274.           end /* non-empty line */
  275.  
  276.         end /* do */
  277.  
  278.       call close('out')
  279.       end
  280.  
  281.     else  REQUESTCHOICE TITLE   '"MakeIndex Request"',
  282.                         BODY    '"Could not write to index file*n*n'      ||,
  283.                                 ESC'c'ESC'b' || indexfile || ESC'n'ESC'l' || '"',
  284.                         GADGETS '"Exit"'
  285.     call close('in')
  286.     end
  287.  
  288.   else  REQUESTCHOICE TITLE   '"MakeIndex Request"',
  289.                       BODY    '"Could not re-open temporary index file*n*n'  ||,
  290.                               ESC'c'ESC'b' || tempfile || ESC'n'ESC'l'       || '"',
  291.                       GADGETS '"Exit"'
  292.   end
  293.  
  294. else  REQUESTCHOICE TITLE   '"MakeIndex Request"',
  295.                     BODY    '"No files found in*n*n'                 ||,
  296.                             ESC'c'ESC'b' || pathname || ESC'n'ESC'l' || '"',
  297.                     GADGETS '"Exit"'
  298.  
  299. MESSAGE '"Deleting temporary files ..."'
  300. address command 'Delete QUIET FILE "' || tempfile || '"'
  301.  
  302. if pos('h',cliopts) > 0 then do
  303.   call close('hp')
  304.   address command 'Delete QUIET FILE "' || temphide || '"'
  305.   end
  306.  
  307. COMPLETE 100
  308. MESSAGE '"done."'
  309. IF POS('a',cliopts) > 0 THEN MESSAGE CLOSE
  310. exit 0
  311.  
  312.  
  313. bad_args: PROCEDURE EXPOSE template ESC
  314.   PARSE ARG msg
  315.  
  316.   REQUESTCHOICE TITLE   '"MakeIndex Request"',
  317.                 BODY    '"' || msg || '*n*n'                     ||,
  318.                         'MakeIndex args template:*n*n'           ||,
  319.                         ESC'c'ESC'b' || template || ESC'n'ESC'l' || '"',
  320.                 GADGETS '"Okay"'
  321.   RETURN 0
  322.  
  323.  
  324. /* compute the size in KBytes, MBytes or GBytes respectively */
  325.  
  326. bkmg: procedure
  327.   arg n
  328.   do p=1 while n >= 2**10
  329.     n = n / 2**10
  330.     end
  331.   n= compress(left(n,3,' '),' ')
  332.   if right(n,1) = '.' then n= compress(n,'.')
  333.   return right(n,3,' ') || substr('BKMG',p,1)
  334.  
  335.  
  336. /* return the size of a file or '-1' if rexxsupport.library was not available */
  337.  
  338. filesize: procedure
  339.   parse arg fname
  340.  
  341.   lib= show('L',"rexxsupport.library")
  342.   if ~lib then lib= addlib("rexxsupport.library",0,-30,0)
  343.  
  344.   if lib then do
  345.     fsize= value( word(statef(fname),2) )
  346.     call remlib("rexxsupport.library")
  347.     end
  348.   else do
  349.     fsize= -1
  350.     MESSAGE '"Warning: rexxsupport.library not available; this may cause further problems ..."'
  351.     REQUESTCHOICE TITLE   '"MakeIndex Request"',
  352.                   BODY    '"'ESC'c'ESC'brexxsupport.library'ESC'n'ESC'l*n*n'    ||,
  353.                           'not available;  this may cause further problems ...' || '"',
  354.                   GADGETS '"Continue"'
  355.     end
  356.  
  357.   return fsize
  358.  
  359.  
  360. /* generate a file list */
  361.  
  362. listfiles: procedure expose lformat pathname ESC
  363.   parse arg infile,outfile
  364.   err = 0
  365.  
  366.   if exists(outfile) then
  367.     address command 'Delete QUIET FILE' '"'outfile'"'
  368.  
  369.   /* create output file (maybe NOCLOBBER is set...) */
  370.   if open('fp',outfile,'W') then do
  371.     call close('fp')
  372.  
  373.     /* Expand the input file */
  374.     if open('fp',infile,'R') then do
  375.       MESSAGE transquote('Expanding file' infile 'to' outfile '...')
  376.       do until eof('fp')
  377.         str= strip( readln('fp') )
  378.         if (words(str) > 0) & (left(str,1) ~= '#') then do
  379.           cwd= pragma('D',pathname)
  380.           signal off ERROR
  381.           address command 'List LFORMAT "' || lformat || '" >>' '"'outfile'"' str
  382.           signal on ERROR
  383.           call pragma('D',cwd)
  384.           end
  385.         end
  386.       call close('fp')
  387.       end
  388.     else do
  389.       REQUESTCHOICE TITLE   '"MakeIndex Request"',
  390.                     BODY    '"MakeIndex failed to open your file*n*n' ||,
  391.                             ESC'c'ESC'b' || infile || ESC'n'ESC'l'    || '"',
  392.                     GADGETS '"Exit"'
  393.       err= 1
  394.       end
  395.     end
  396.   else do
  397.     REQUESTCHOICE TITLE   '"MakeIndex Request"',
  398.                   BODY    '"MakeIndex could not write to*n*n'     ||,
  399.                           ESC'c'ESC'b' || outfile || ESC'n'ESC'l' || '"',
  400.                   GADGETS '"Exit"'
  401.     err= 2
  402.     end
  403.  
  404.   return err
  405.  
  406. /*@*/
  407.  
  408.  
  409. /* translate '"' into '*"' and '*' into '**' */
  410.  
  411. transquote: procedure
  412.   parse arg s
  413.   t= s
  414.   q= max( lastpos('*',s), lastpos('"',s) )
  415.   do while q > 0
  416.     t= insert('*',t,q-1,1)
  417.     s= left(s,q-1)
  418.     q= max( lastpos('*',s), lastpos('"',s) )
  419.     end
  420.   return '"' || t || '"'
  421.  
  422.  
  423. /* return the non-file part of a pathname */
  424.  
  425. pathonly: procedure
  426.   parse arg path
  427.   if (words(path) > 0) & (right(path,1) ~= ':') then do
  428.     if right(path,1) = '/' then path= left(path,length(path)-1)
  429.     if lastpos('/',path) > lastpos(':',path) then path= left(path,lastpos('/',path)-1)
  430.                                              else path= left(path,lastpos(':',path))
  431.     end
  432.   return path
  433.  
  434.  
  435. /* return the file part of a pathname */
  436.  
  437. fileonly: procedure
  438.   parse arg path
  439.   if right(path,1) = '/' then path= left(path,length(path)-1)
  440.   p= max( lastpos(':',path), lastpos('/',path) )
  441.   if(p>0) then return substr(path,p+1)
  442.           else return path
  443.  
  444.  
  445. /* concatenate the filename to the pathname and return the resulting string */
  446.  
  447. tackon: procedure
  448.   parse arg path,file
  449.   do while left(file,1) = '/'
  450.     file= substr(file,2)
  451.     path= pathonly(path)
  452.     end
  453.   if (words(path) > 0) & (right(path,1) ~= '/') & (right(path,1) ~= ':') then path= path || '/'
  454.   if (right(file,1) = '/') then file= left(file,length(file)-1)
  455.   return path || file
  456.  
  457.  
  458. /* create all non-existant directories in a path */
  459.  
  460. makepath: procedure
  461.   parse arg path
  462.   if right(path,1) = '/' then path= left(path,length(path)-1)
  463.   if ~exists(path) then do
  464.     call makepath( pathonly(path) )
  465.     address command 'MakeDir NAME "'path'"'
  466.     end
  467.   return 0
  468.  
  469.  
  470. /*
  471.  * return   1  if the device or volume name in given pathname exists
  472.  *             or if no device or volume was present (current device)
  473.  *          0  if the device or volume name does not exist
  474.  */
  475.  
  476. canexist: procedure
  477.   parse upper arg path
  478.   if pos(':',path) < 1 then return 1 /* current device */
  479.   call pragma('W','N')
  480.   return exists( left(path,lastpos(':',path)) )
  481.  
  482.  
  483. /* stretch the blue completion bar */
  484.  
  485. step_gauge: PROCEDURE EXPOSE dg gstepN
  486.   ARG increment
  487.   gstepN= gstepN + 1
  488.   c= MIN(TRUNC(gstepN * increment * dg),100)
  489.   COMPLETE c
  490.   IF c >= 100 THEN WORKING '"done."'
  491.   RETURN 0
  492.  
  493.  
  494. /* initialize the gauge increment by counting the #of steps to be performed */
  495.  
  496. init_gauge: PROCEDURE EXPOSE dg gstepN
  497.   PARSE ARG fname,steps_per_entry
  498.  
  499.   dg = 0         /* gauge increment */
  500.   gstepN = 0     /* #of performed steps */
  501.  
  502.   IF OPEN('fp',fname,'R') THEN DO
  503.     numentries= 0
  504.     DO UNTIL EOF('fp')
  505.       IF WORDS(READLN('fp')) > 0 THEN
  506.         numentries= numentries+1
  507.       END
  508.     MESSAGE '"Processing' numentries 'entries ..."'
  509.     dg = 100 / (numentries * steps_per_entry)
  510.     CALL SEEK('fp',0,'B')
  511.     CALL CLOSE('fp')
  512.     END
  513.  
  514.   /*MESSAGE CLEAR; MESSAGE OPEN*/
  515.   COMPLETE 0
  516.   RETURN 0
  517.  
  518.  
  519. /* error/break handling */
  520.  
  521. IOERR:
  522. ERROR:
  523.   err= rc
  524.   ESC = '1b'x
  525.  
  526.   signal off ERROR
  527.   signal off IOERR
  528.  
  529.   WORKING '"I/O problem trapped... Execution halted."'
  530.   MESSAGE '"I/O problem trapped... Execution halted."'
  531.  
  532.   REQUESTCHOICE TITLE   '"MakeIndex Error Trap' err'"',
  533.                 BODY    '"There was a problem with external I/O in line' sigl '...*n' ||,
  534.                         ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                || '"',
  535.                 GADGETS '"I''ll better exit"'
  536.   exit
  537.  
  538.  
  539. FAILURE:
  540. NOVALUE:
  541. SYNTAX:
  542.   err= rc
  543.   ESC = '1b'x
  544.  
  545.   signal off FAILURE
  546.   signal off NOVALUE
  547.   signal off SYNTAX
  548.  
  549.   WORKING '"Internal problem trapped... Execution halted."'
  550.   MESSAGE '"Internal problem trapped... Execution halted."'
  551.  
  552.   REQUESTCHOICE TITLE   '"MakeIndex Internal Error' err'"',
  553.                 BODY    '"MakeIndex seems to have an internal problem in line' sigl '...*n' ||,
  554.                         ESC'c'ESC'b' || ERRORTEXT(err) || ESC'n'ESC'l'                      || '"',
  555.                 GADGETS '"I''ll better exit"'
  556.   exit
  557.  
  558.  
  559. HALT:
  560. BREAK_C:
  561. BREAK_D:
  562.   signal off HALT
  563.   signal off BREAK_C
  564.   signal off BREAK_D
  565.  
  566.   WORKING '"Break signal trapped... Execution halted."'
  567.   MESSAGE '"Break signal trapped... Execution halted."'
  568.  
  569.   REQUESTCHOICE TITLE   '"MakeIndex Break Trap"',
  570.                 BODY    '"Script execution halted."',
  571.                 GADGETS '"Stop"'
  572.   exit
  573.